home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / PROGRAMM / PASCAL / 0798.ZIP / SAMPLE.PAS < prev    next >
Pascal/Delphi Source File  |  1987-10-05  |  13KB  |  426 lines
  1. (*ScreenEngine
  2. ScrnSample
  3. 1 2 15 35
  4. 18 11 0 0 21 15 0 5 1 LastName
  5.  
  6. zzzzzzzzzzzzzzzzzzzz
  7. 1 6 80 23 2 2 15 1 0    
  8. 18 13 0 0 21 15 0 5 1 FirstName
  9.  
  10. zzzzzzzzzzzzzzzzzzzz
  11. 20 15 0 0 1 15 0 5 1 MiddleInit
  12.  
  13. Z
  14. 11 17 0 0 28 15 0 5 1 Street
  15.  
  16. zzzzzzzzzzzzzzzzzzzzzzzzzz
  17. 18 19 0 0 21 15 0 5 1 Town
  18.  
  19. zzzzzzzzzzzzzzzzz
  20. 13 21 0 0 2 15 0 5 1 State
  21. AL
  22. WY
  23. 29 21 0 0 5 15 0 5 1 Zip
  24. 00000
  25. 99999
  26. 51 11 0 0 25 15 0 5 1 DrName
  27.  
  28. zzzzzzzzzzzzzzzzzzzzzzzz
  29. 68 13 4 0 8 15 0 6 1 LastVisit
  30. 000101
  31. 991231
  32. 68 15 0 0 3 15 0 3 1 TreatCode
  33. 0 333
  34. 68 17 1 2 6 15 0 4 1 Charges
  35.   2.5000000000E+01   3.0000000000E+02
  36. 3 11 0 0 10 1 15 2 0 Last Name:
  37. 42 13 0 0 25 1 15 2 0 Date of Visit (MM/DD/YY):
  38. 43 21 0 0 16 4 14 2 0 Account Balance:
  39. 68 21 1 2 8 15 0 4 0 Balance
  40.   0.0000000000E+00   0.0000000000E+00
  41. 24 21 0 0 4 1 15 2 0 ZIP:
  42. 3 17 0 0 7 1 15 2 0 Street:
  43. 19 3 0 0 36 4 15 2 0 CLIENT INFORMATION MANAGEMENT SYSTEM
  44. 3 13 0 0 11 1 15 2 0 First Name:
  45. 3 15 0 0 15 1 15 2 0 Middle Initial:
  46. 40 7 40 22 2 2 15 1 2    
  47. 40 23 40 23 202 2 15 1 2
  48. 40 6 40 6 203 2 15 1 2  
  49. 2 7 39 9 1 2 15 1 2  
  50. 15 8 0 0 11 1 15 2 0 CLIENT DATA
  51. 41 7 79 9 1 2 15 1 2  
  52. 52 8 0 0 16 1 15 2 0 APPOINTMENT DATA
  53. 42 11 0 0 7 1 15 2 0 Doctor:
  54. 3 19 0 0 13 1 15 2 0 City or Town:
  55. 42 15 0 0 25 1 15 2 0 Treatment Code (000-333):
  56. 3 21 0 0 6 1 15 2 0 State:
  57. 42 17 0 0 23 1 15 2 0 Charges (25.00-300.00):
  58. 1 1 80 5 3 3 12 1 0  
  59. 42 20 77 22 1 2 15 1 2  
  60. *)
  61. Program ScrnSample; {Replace this line with your own}
  62. {Type declaration}
  63. type
  64.   TSStr     = String[80];
  65.   TSCharSet = set of char;
  66.   TSDate    = String[6];
  67. {Global variables}
  68. var
  69.   TSString  :  TSStr;
  70. TSDefAttrib:  byte;    {Screen color attribute}
  71. TSInsMode  :  boolean; {keeps track of the insert key}
  72.                 LastName: String[21];
  73.                FirstName: String[21];
  74.               MiddleInit: String[1];
  75.                   Street: String[28];
  76.                     Town: String[21];
  77.                    State: String[2];
  78.                      Zip: String[5];
  79.                   DrName: String[25];
  80.                LastVisit: TSDate;
  81.                TreatCode: integer;
  82.                  Charges: real;
  83.                  Balance: real;
  84.  
  85. {$I TBS.UTL}
  86. {$I TBSREAL.UTL}  {utilities for real variables. Delete if not needed}
  87. {$I TBSDATE.UTL}  {utilities for date variables. Delete if not needed}
  88. {$I TBSINT.UTL}   {utilities for integer variables. Delete if not needed}
  89.   procedure PutTitleScrnSample;
  90. begin
  91.       TextBackground(2);
  92.       TextColor(15);
  93.       ClrScr;
  94.      Box(1,6,80,23,2,47,
  95.        'O.O=!O>ΘO-Ω).N0 P.v0 Q;t= ');
  96.      Box(1,1,80,5,3,60,
  97.        '');
  98.     PutVariableOrLabel(3,11,31,'Last Name:',10);
  99.     PutVariableOrLabel(42,13,31,'Date of Visit (MM/DD/YY):',25);
  100.     PutVariableOrLabel(43,21,78,'Account Balance:',16);
  101.     PutVariableOrLabel(24,21,31,'ZIP:',4);
  102.     PutVariableOrLabel(3,17,31,'Street:',7);
  103.     PutVariableOrLabel(19,3,79,'CLIENT INFORMATION MANAGEMENT SYSTEM',36);
  104.     PutVariableOrLabel(3,13,31,'First Name:',11);
  105.     PutVariableOrLabel(3,15,31,'Middle Initial:',15);
  106.     PutVariableOrLabel(15,8,31,'CLIENT DATA',11);
  107.     PutVariableOrLabel(52,8,31,'APPOINTMENT DATA',16);
  108.     PutVariableOrLabel(42,11,31,'Doctor:',7);
  109.     PutVariableOrLabel(3,19,31,'City or Town:',13);
  110.     PutVariableOrLabel(42,15,31,'Treatment Code (000-333):',25);
  111.     PutVariableOrLabel(3,21,31,'State:',6);
  112.     PutVariableOrLabel(42,17,31,'Charges (25.00-300.00):',23);
  113. end; {of procedure}
  114.  
  115. procedure  OutVarScrnSample(
  116.      var         LastName : TSStr;
  117.      var        FirstName : TSStr;
  118.      var       MiddleInit : TSStr;
  119.      var           Street : TSStr;
  120.      var             Town : TSStr;
  121.      var            State : TSStr;
  122.      var              Zip : TSStr;
  123.      var           DrName : TSStr;
  124.      var        LastVisit : TSDate;
  125.      var        TreatCode : Integer;
  126.      var          Charges : Real;
  127.      var          Balance : Real);
  128. begin
  129.     PutVariableOrLabel(18,11,240,LastName,
  130.         21);
  131.     PutVariableOrLabel(18,13,240,FirstName,
  132.         21);
  133.     PutVariableOrLabel(20,15,240,MiddleInit,
  134.          1);
  135.     PutVariableOrLabel(11,17,240,Street,
  136.         28);
  137.     PutVariableOrLabel(18,19,240,Town,
  138.         21);
  139.     PutVariableOrLabel(13,21,240,State,
  140.          2);
  141.     PutVariableOrLabel(29,21,240,Zip,
  142.          5);
  143.     PutVariableOrLabel(51,11,240,DrName,
  144.         25);
  145.     PutDate(68,13,240,LastVisit,
  146.           '/',3,1,2);
  147.     PutInteger(68,15,240,TreatCode,
  148.          3);
  149.     PutReal(68,17,240,Charges,
  150.          6,1,2);
  151.     PutReal(68,21,240,Balance,
  152.          8,1,2);
  153. end;
  154.  
  155. procedure  InpVarScrnSample(
  156.      var         LastName : TSStr;
  157.      var        FirstName : TSStr;
  158.      var       MiddleInit : TSStr;
  159.      var           Street : TSStr;
  160.      var             Town : TSStr;
  161.      var            State : TSStr;
  162.      var              Zip : TSStr;
  163.      var           DrName : TSStr;
  164.      var        LastVisit : TSDate;
  165.      var        TreatCode : Integer;
  166.      var          Charges : Real;
  167.      var          Balance : Real);
  168.  {$V-}         {Do not remove this compiler directive
  169.   it is required to disable type checking in this procedure}
  170.  type
  171.    TSCharSet = set of Char;
  172.  var
  173.    Chr1,Chr2 : Char;
  174.    L         : Byte;
  175.  Const
  176.    End1 : TSCharSet = [^I,^M,#27,#10];
  177.    End2 : TSCharSet = ['H','P',#15];
  178.  begin
  179.   OutVarScrnSample(
  180.                  LastName,
  181.                 FirstName,
  182.                MiddleInit,
  183.                    Street,
  184.                      Town,
  185.                     State,
  186.                       Zip,
  187.                    DrName,
  188.                 LastVisit,
  189.                 TreatCode,
  190.                   Charges,
  191.                   Balance);
  192.   L  := 1;
  193. repeat
  194. case L of
  195.     1 : GetString(18,11,240,LastName,End1,End2,Chr1,Chr2,
  196.         21,'','zzzzzzzzzzzzzzzzzzzz');
  197.     2 : GetString(18,13,240,FirstName,End1,End2,Chr1,Chr2,
  198.         21,'','zzzzzzzzzzzzzzzzzzzz');
  199.     3 : GetString(20,15,240,MiddleInit,End1,End2,Chr1,Chr2,
  200.          1,'','Z');
  201.     4 : GetString(11,17,240,Street,End1,End2,Chr1,Chr2,
  202.         28,'','zzzzzzzzzzzzzzzzzzzzzzzzzz');
  203.     5 : GetString(18,19,240,Town,End1,End2,Chr1,Chr2,
  204.         21,'','zzzzzzzzzzzzzzzzz');
  205.     6 : GetString(13,21,240,State,End1,End2,Chr1,Chr2,
  206.          2,'AL','WY');
  207.     7 : GetString(29,21,240,Zip,End1,End2,Chr1,Chr2,
  208.          5,'00000','99999');
  209.     8 : GetString(51,11,240,DrName,End1,End2,Chr1,Chr2,
  210.         25,'','zzzzzzzzzzzzzzzzzzzzzzzz');
  211.     9 : GetDate(68,13,240,LastVisit,End1,End2,Chr1,Chr2,
  212.           '/',3,1,2,'000101','991231');
  213.     10 : GetInteger(68,15,240,TreatCode,End1,End2,Chr1,Chr2,
  214.          3,0,333);
  215.     11 : GetReal(68,17,240,Charges,End1,End2,Chr1,Chr2,
  216.          6,1,2,  2.5000000000E+01,  3.0000000000E+02);
  217.   end; {of case}
  218.   if (Chr1 = ^I) or (Chr1 = ^M) or ((Chr1 = #27) and (Chr2 ='P')) then
  219.       if L = 11 then  L := 1 else L := L+1
  220.  else
  221.   if (Chr1 = #27) and ((Chr2 = 'H') or (Chr2 = #15)) then
  222.       if L = 1 then L := 11 else L := L-1;
  223.   until ((Chr1 = ^M) and (L = 1)) or (Chr1 = #10);
  224. {$V+}    {Do not remove this compiler directive
  225.           it enables type checking}
  226. end;
  227.  
  228. procedure  InpScrnSample(
  229.      var         LastName : TSStr;
  230.      var        FirstName : TSStr;
  231.      var       MiddleInit : TSStr;
  232.      var           Street : TSStr;
  233.      var             Town : TSStr;
  234.      var            State : TSStr;
  235.      var              Zip : TSStr;
  236.      var           DrName : TSStr;
  237.      var        LastVisit : TSDate;
  238.      var        TreatCode : Integer;
  239.      var          Charges : Real;
  240.      var          Balance : Real);
  241. begin
  242. (************** Initialize Variables **************)
  243. (* SUBSTITUTE THESE VALUES WITH YOUR OWN DEFAULTS *)
  244.     LastName := '';
  245.     FirstName := '';
  246.     MiddleInit := '';
  247.     Street := '';
  248.     Town := '';
  249.     State := '';
  250.     Zip := '';
  251.     DrName := '';
  252.     LastVisit := '000101';
  253.     TreatCode := 0;
  254.     Charges := 0.0;
  255.     Balance := 0.0;
  256.  
  257.   PutTitleScrnSample;
  258.   InpVarScrnSample(
  259.                  LastName,
  260.                 FirstName,
  261.                MiddleInit,
  262.                    Street,
  263.                      Town,
  264.                     State,
  265.                       Zip,
  266.                    DrName,
  267.                 LastVisit,
  268.                 TreatCode,
  269.                   Charges,
  270.                   Balance);
  271. end; {of procedure}
  272.  
  273. procedure  EditScrnSample(
  274.      var         LastName : TSStr;
  275.      var        FirstName : TSStr;
  276.      var       MiddleInit : TSStr;
  277.      var           Street : TSStr;
  278.      var             Town : TSStr;
  279.      var            State : TSStr;
  280.      var              Zip : TSStr;
  281.      var           DrName : TSStr;
  282.      var        LastVisit : TSDate;
  283.      var        TreatCode : Integer;
  284.      var          Charges : Real;
  285.      var          Balance : Real);
  286. begin
  287.   PutTitleScrnSample;
  288.   InpVarScrnSample(
  289.                  LastName,
  290.                 FirstName,
  291.                MiddleInit,
  292.                    Street,
  293.                      Town,
  294.                     State,
  295.                       Zip,
  296.                    DrName,
  297.                 LastVisit,
  298.                 TreatCode,
  299.                   Charges,
  300.                   Balance);
  301. end; {of procedure}
  302.  
  303. procedure  OutScrnSample(
  304.      var         LastName : TSStr;
  305.      var        FirstName : TSStr;
  306.      var       MiddleInit : TSStr;
  307.      var           Street : TSStr;
  308.      var             Town : TSStr;
  309.      var            State : TSStr;
  310.      var              Zip : TSStr;
  311.      var           DrName : TSStr;
  312.      var        LastVisit : TSDate;
  313.      var        TreatCode : Integer;
  314.      var          Charges : Real;
  315.      var          Balance : Real);
  316. begin
  317.   PutTitleScrnSample;
  318.   OutVarScrnSample(
  319.                  LastName,
  320.                 FirstName,
  321.                MiddleInit,
  322.                    Street,
  323.                      Town,
  324.                     State,
  325.                       Zip,
  326.                    DrName,
  327.                 LastVisit,
  328.                 TreatCode,
  329.                   Charges,
  330.                   Balance);
  331. end; {of procedure}
  332. (**************Test      Program************)
  333. (***SUBSTITUTE THIS PROGRAM WITH YOUR OWN***)
  334. begin
  335.    TSInsMode   := false;
  336.    TSDefAttrib :=  47;
  337. (* Place the following calling sequence in the appropriate
  338.    location in your program  *)
  339.  {$V-}         {Do not remove this compiler directive
  340.   it is required to disable type checking in this procedure}
  341.  
  342.  
  343.  
  344.  
  345.  InpScrnSample(
  346.                  LastName,
  347.                 FirstName,
  348.                MiddleInit,
  349.                    Street,
  350.                      Town,
  351.                     State,
  352.                       Zip,
  353.                    DrName,
  354.                 LastVisit,
  355.                 TreatCode,
  356.                   Charges,
  357.                   Balance);
  358.  
  359. {$V+}    {Do not remove this compiler directive
  360.           it enables type checking}
  361.    {delete the next three lines after you have tested the screen program}
  362. GotoXY(1,25);ClrEOL;
  363. write('End of Input test. Press any key to continue');
  364. repeat until KeyPressed;
  365.  
  366. (* Place the following calling sequence in the appropriate
  367.    location in your program  *)
  368.  
  369.  {$V-}         {Do not remove this compiler directive
  370.   it is required to disable type checking in this procedure}
  371.  
  372.  
  373.  
  374.  
  375.  OutScrnSample(
  376.                  LastName,
  377.                 FirstName,
  378.                MiddleInit,
  379.                    Street,
  380.                      Town,
  381.                     State,
  382.                       Zip,
  383.                    DrName,
  384.                 LastVisit,
  385.                 TreatCode,
  386.                   Charges,
  387.                   Balance);
  388.  
  389. {$V+}    {Do not remove this compiler directive
  390.           it enables type checking}
  391.    {delete the next three lines after you have tested the screen program}
  392. GotoXY(1,25);ClrEOL;
  393. write('End of Output test. Press any key to continue');
  394. repeat until KeyPressed;
  395.  
  396. (* Place the following calling sequence in the appropriate
  397.    location in your program  *)
  398.  {$V-}         {Do not remove this compiler directive
  399.   it is required to disable type checking in this procedure}
  400.  
  401.  
  402.  
  403.  
  404.  EditScrnSample(
  405.                  LastName,
  406.                 FirstName,
  407.                MiddleInit,
  408.                    Street,
  409.                      Town,
  410.                     State,
  411.                       Zip,
  412.                    DrName,
  413.                 LastVisit,
  414.                 TreatCode,
  415.                   Charges,
  416.                   Balance);
  417.  
  418. {$V+}    {Do not remove this compiler directive
  419.           it enables type checking}
  420.    {delete the next three lines after you have tested the screen program}
  421. GotoXY(1,25);ClrEOL;
  422. write('End of program test. Press any key to continue');
  423. repeat until KeyPressed;
  424.       {delete next line after you have tested the screen program}
  425.  end.
  426.